# schema1.pl
use strict;
use warnings;

#
#   Infer path index set and schema information of a Perl variable
#

my $FALSE = 0;
my $TRUE  = 1;

sub path_index_set {
    #
    #   ARRAY_REF path_index_set(VARIABLE $value[, HASHREF $options])
    #
    #   Returns an array of JSONPath expressions indexing all sub-terms of Perl variable $value.
    #
    #   Options:
    #       'canonical' => $TRUE    sorts hashes on their keys to ensure canonical order. Default = $TRUE
    #       'pretty' => $TRUE       pretty print with indentation. Default = $TRUE
    #
    my ($value, $options) = @_;
    
    if (!defined $options || ref($options) ne 'HASH') {
        $options = {};
    }

    $options->{'canonical'} = (defined $options->{'canonical'} && $options->{'canonical'} eq "$FALSE") ? $FALSE : $TRUE;
    $options->{'pretty'}    = (defined $options->{'pretty'}    && $options->{'pretty'} eq "$FALSE")    ? $FALSE : $TRUE;
    
    # we overload the options hash to also carry around indentation state information
    $options->{'_indent'} = 0;
    $options->{'_paths'}  = {};     #for efficiency: use global result arrayref to avoid returns having to splice arrays

    if (defined $value && (ref($value) eq 'HASH' || ref($value) eq 'ARRAY' || $value ne '')) {
        $options->{'_indent'}++;
        scan_term_value($value, '$', $options);
    }

    return $options->{'_paths'};
}

sub scan_term_value {
    my ($value, $stem, $options) = @_;
    if (!defined $value) {
        return;
    }
    elsif (ref($value) eq 'HASH') {
        $options->{'_paths'}{$stem . '.*'} = $value;
        scan_term_hash($value, $stem, $options);
        return;
    }
    elsif (ref($value) eq 'ARRAY') {
        $options->{'_paths'}{$stem . '[*]'} = $value;
        scan_term_array($value, $stem, $options);
        return;
    }
    elsif ($value ne '') {
        $options->{'_paths'}{$stem} = $value;
        return;
    }
    return;
}

sub scan_term_hash {
    my ($hash_ref, $stem, $options) = @_;

    my @keys = keys %$hash_ref;
    if ($options->{'canonical'}) {
        @keys = sort @keys;
    }
    $options->{'_nargs' . $options->{'_indent'}} = scalar(@keys);
    for my $key (@keys) {
        my $value = $hash_ref->{$key};
        if ($value ne '') {
            $options->{'_indent'}++;
            $options->{'_nargs' . $options->{'_indent'}} = 0;
            scan_term_value($value, $stem . '.' . atomquote($key), $options);
            $options->{'_indent'}--;
        }
    }
}

sub scan_term_array {
    my ($array_ref, $stem, $options) = @_;

    $options->{'_nargs' . $options->{'_indent'}} = scalar(@$array_ref);
    my $i = 0;
    for my $value (@$array_ref) {
        if ($value ne '') {
            $options->{'_indent'}++;
            $options->{'_nargs' . $options->{'_indent'}} = 0;
            scan_term_value($value, $stem . '[' . $i . ']', $options);
            $options->{'_indent'}--;
        }
        $i++;
    }
}

sub atomquote {
    my ($str) = @_;
    if (defined $str) {
        if ($str =~ m{[\.\[\]\']}xs) {  #FIXME: can't find formal syntax but apart from pathalogical examples, this works
            $str =~ s/\'/\\\'/gsmx;
            $str = '[\'' . $str . '\']';
        }
    }
    else {
        die 'Undefined string!';
    }
    return $str;
}

1;
